home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / bbs / tdk_v136.zip / ANSIUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1997-07-02  |  8KB  |  309 lines
  1. {
  2.  ▀▀▀▀▀▀▀▀  ▀▀▀▀▀▀    ▀▀   ▀▀
  3.    ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  4.   ▀▀     ▀▀   ▀▀▀  ▀▀▀▀▀  The DoorKit!
  5.  ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  6. ▀▀     ▀▀▀▀▀▀    ▀▀    ▀▀
  7. The BBS Door Development Kit By The People - For The People!
  8.  
  9.  
  10.    Feel free to modify or optimize this code at will. All I ask is that if
  11.    find a better way to do things (and you will), please send me a copy of
  12.    your modifications. Thanks in advance!....Larry L. Athey....}
  13.  
  14. {$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
  15. UNIT ANSIUNIT;
  16.  
  17. INTERFACE
  18.  
  19. PROCEDURE DisplayANSI(Ch : CHAR);
  20. {^ Displays a single character of an ANSI sequence to the screen, nothing
  21.    is sent to the comport. You shouldn't ever have to call this procedure
  22.    manually, this is taken care of by DOORKIT3.PAS / ShowScreen.}
  23. PROCEDURE DisplayANSIstr(S : STRING);
  24. {^ Displays a string of ANSI sequences to the screen, nothing is sent to
  25.    the comport. You shouldn't ever have to call this procedure manually,
  26.    this is taken care of by DOORKIT3.PAS / ShowScreen.}
  27. PROCEDURE ResetAnsi;
  28. {^ Resets all variables in this unit. You shouldn't ever have to call this
  29.    procedure manually, this is taken care of by DOORKIT1.PAS / sClrScr.}
  30.  
  31. IMPLEMENTATION
  32.  
  33. USES CRT;
  34.  
  35. VAR
  36.   ANSIst    : STRING;
  37.   ANSI_SCPL : INTEGER;
  38.   ANSI_SCPC : INTEGER;
  39.   ANSI_FG   : INTEGER;
  40.   ANSI_BG   : INTEGER;
  41.   ANSI_C,
  42.   ANSI_I,
  43.   ANSI_B,
  44.   ANSI_R    : BOOLEAN;
  45.   P,X,Y     : INTEGER;
  46.  
  47. PROCEDURE DisplayANSI(Ch : CHAR);
  48.  
  49. PROCEDURE TABULATE;
  50. VAR
  51.   X : INTEGER;
  52. BEGIN
  53.   X := WHEREX;
  54.   IF X < 80 THEN REPEAT INC(X) UNTIL (X MOD 8) = 0;
  55.   IF X = 80 THEN X := 1;
  56.   GOTOXY(X,WHEREY);
  57.   IF X = 1 THEN WRITELN;
  58. END;
  59.  
  60. PROCEDURE BACKSPACE;
  61. VAR
  62.   X : INTEGER;
  63. BEGIN
  64.   IF WHEREX > 1 THEN WRITE(^H,' ',^H) ELSE
  65.   IF WHEREY > 1 THEN BEGIN
  66.     GOTOXY(80,WHEREY - 1);
  67.     WRITE(' ');
  68.     GOTOXY(80,WHEREY - 1);
  69.   END;
  70. END;
  71.  
  72. PROCEDURE TTY(Ch : CHAR);
  73. VAR
  74.   X : INTEGER;
  75. BEGIN
  76.   IF ANSI_C THEN BEGIN
  77.     IF ANSI_I THEN ANSI_FG := ANSI_FG OR 8;
  78.     IF ANSI_B THEN ANSI_FG := ANSI_FG OR 16;
  79.     IF ANSI_R THEN BEGIN
  80.       X := ANSI_FG;
  81.       ANSI_FG := ANSI_BG;
  82.       ANSI_BG := x;
  83.     END;
  84.     ANSI_C := FALSE;
  85.   END;
  86.   TEXTCOLOR(ANSI_FG);
  87.   TEXTBACKGROUND(ANSI_BG);
  88.   CASE Ch OF
  89.     ^G : BEGIN
  90.            SOUND(2000);
  91.            DELAY(75);
  92.            NOSOUND;
  93.          END;
  94.     ^H : Backspace;
  95.     ^I : Tabulate;
  96.     ^J : BEGIN
  97.            TEXTBACKGROUND(0);
  98.            WRITE(^J);
  99.          END;
  100.     ^K : GOTOXY(1,1);
  101.     ^L : BEGIN
  102.            TEXTBACKGROUND(0);
  103.            CLRSCR;
  104.          END;
  105.     ^M : BEGIN
  106.            TEXTBACKGROUND(0);
  107.            WRITE(^M);
  108.          END;
  109.     ELSE WRITE(Ch);
  110.   END;
  111. END;
  112.  
  113. PROCEDURE ANSIWrite(S : STRING);
  114. VAR
  115.   X : INTEGER;
  116. BEGIN
  117.   IF POS('D',S) > 0 THEN EXIT;
  118.   FOR X := 1 TO LENGTH(S) DO TTY(S[X]);
  119. END;
  120.  
  121. FUNCTION Param : INTEGER;
  122. VAR
  123.   S  : STRING;
  124.   X,
  125.   XX : INTEGER;
  126.   B  : BOOLEAN;
  127. BEGIN
  128.   B := FALSE;
  129.   FOR X := 3 TO LENGTH(ANSIst) DO IF ANSIst[X] IN ['0'..'9'] THEN B := TRUE;
  130.   IF NOT B THEN Param := - 1 ELSE BEGIN
  131.     S := '';
  132.     X := 3;
  133.     IF ANSIst[3] = ';' THEN BEGIN
  134.       Param := 0;
  135.       DELETE(ANSIst,3,1);
  136.       EXIT;
  137.     END;
  138.     REPEAT
  139.       S := S + ANSIst[X];
  140.       X := X + 1;
  141.     UNTIL (NOT (ANSIst[X] IN ['0'..'9'])) OR (LENGTH(S) > 2) OR (X > LENGTH(ANSIst));
  142.     IF LENGTH(S) > 2 THEN BEGIN
  143.       ANSIWrite(ANSIst + Ch);
  144.       ANSIst := '';
  145.       Param := - 1;
  146.       EXIT;
  147.     END;
  148.     DELETE(ANSIst,3,LENGTH(S));
  149.     IF ANSIst[3] = ';' THEN DELETE(ANSIst,3,1);
  150.     VAL(S,X,XX);
  151.     Param := X;
  152.   END;
  153. END;
  154.  
  155. BEGIN
  156.   IF (Ch <> #27) AND (ANSIst = '') THEN BEGIN
  157.     TTY(Ch);
  158.     EXIT;
  159.   END;
  160.   IF Ch = #27 THEN BEGIN
  161.     IF ANSIst <> '' THEN BEGIN
  162.       ANSIWrite(ANSIst + #27);
  163.       ANSIst := '';
  164.     END ELSE ANSIst := #27;
  165.     EXIT;
  166.   END;
  167.   IF ANSIst = #27 THEN BEGIN
  168.     IF Ch = '[' THEN ANSIst := #27 + '[' ELSE BEGIN
  169.       ANSIWrite(ANSIst + Ch);
  170.       ANSIst := '';
  171.     END;
  172.     EXIT;
  173.   END;
  174.   IF (Ch = '[') AND (ANSIst <> '') THEN BEGIN
  175.     ANSIWrite(ANSIst + '[');
  176.     ANSIst := '';
  177.     EXIT;
  178.   END;
  179.   IF NOT (Ch IN ['0'..'9',';','A'..'D','f','H','J','K','m','s','u']) THEN BEGIN
  180.     ANSIWrite(ANSIst + Ch);
  181.     ANSIst := '';
  182.     EXIT;
  183.   END;
  184.   IF Ch IN ['A'..'D','f','H','J','K','m','s','u'] THEN BEGIN
  185.     CASE Ch OF
  186.       'A' : BEGIN
  187.               P := Param;
  188.               IF P = - 1 THEN P := 1;
  189.               IF WHEREY - P < 1 THEN GOTOXY(WHEREX,1) ELSE GOTOXY(WHEREX,WHEREY - P);
  190.             END;
  191.       'B' : BEGIN
  192.               P := Param;
  193.               IF P = - 1 THEN P := 1;
  194.               IF WHEREY + P > 25 THEN GOTOXY(WHEREX,25) ELSE GOTOXY(WHEREX,WHEREY + P);
  195.             END;
  196.       'C' : BEGIN
  197.               P := Param;
  198.               IF P = - 1 THEN P := 1;
  199.               IF WHEREX + P > 80 THEN GOTOXY(80,WHEREY) ELSE GOTOXY(WHEREX + P,WHEREY);
  200.               END;
  201.       'D' : BEGIN
  202.               P := Param;
  203.               IF P = - 1 THEN P := 1;
  204.               IF WHEREX - P < 1 THEN GOTOXY(1,WHEREY) ELSE GOTOXY(WHEREX - P,WHEREY);
  205.             END;
  206.       'H',
  207.       'f' : BEGIN
  208.               Y := Param;
  209.               X := Param;
  210.               IF Y < 1 THEN Y := 1;
  211.               IF X < 1 THEN X := 1;
  212.               IF (X > 80) OR (X < 1) OR (Y > 25) OR (Y < 1) THEN BEGIN
  213.                 ANSIst := '';
  214.                 EXIT;
  215.               END;
  216.               GOTOXY(X,Y);
  217.             END;
  218.       'J' : BEGIN
  219.               P := Param;
  220.               IF P IN [0,1,2] THEN CLRSCR;
  221.             END;
  222.       'K' : CLREOL;
  223.       'm' : BEGIN
  224.               IF ANSIst = #27 + '[' THEN BEGIN
  225.                 ANSI_FG := 7;
  226.                 ANSI_BG := 0;
  227.                 ANSI_I := FALSE;
  228.                 ANSI_B := FALSE;
  229.                 ANSI_R := FALSE;
  230.               END;
  231.               REPEAT
  232.                 P := Param;
  233.                 CASE P OF
  234.                 - 1 : ;
  235.                   0 : BEGIN
  236.                         ANSI_FG := 7;
  237.                         ANSI_BG := 0;
  238.                         ANSI_I  := FALSE;
  239.                         ANSI_R  := FALSE;
  240.                         ANSI_B  := FALSE;
  241.                       END;
  242.                   1 : ANSI_I  := TRUE;
  243.                   5 : ANSI_B  := TRUE;
  244.                   7 : ANSI_R  := TRUE;
  245.                  30 : ANSI_FG := 0;
  246.                  31 : ANSI_FG := 4;
  247.                  32 : ANSI_FG := 2;
  248.                  33 : ANSI_FG := 6;
  249.                  34 : ANSI_FG := 1;
  250.                  35 : ANSI_FG := 5;
  251.                  36 : ANSI_FG := 3;
  252.                  37 : ANSI_FG := 7;
  253.                  40 : ANSI_BG := 0;
  254.                  41 : ANSI_BG := 4;
  255.                  42 : ANSI_BG := 2;
  256.                  43 : ANSI_BG := 6;
  257.                  44 : ANSI_BG := 1;
  258.                  45 : ANSI_BG := 5;
  259.                  46 : ANSI_BG := 3;
  260.                  47 : ANSI_BG := 7;
  261.                END;
  262.                IF ((P >= 30) AND (P <= 47)) OR (P = 1) OR (P = 5) OR (P = 7) THEN ANSI_C := TRUE;
  263.              UNTIL P = - 1;
  264.            END;
  265.      's' : BEGIN
  266.              ANSI_SCPL := WHEREY;
  267.              ANSI_SCPC := WHEREX;
  268.            END;
  269.      'u' : BEGIN
  270.              IF ANSI_SCPL > - 1 THEN GOTOXY(ANSI_SCPC,ANSI_SCPL);
  271.              ANSI_SCPL := - 1;
  272.              ANSI_SCPC := - 1;
  273.            END;
  274.     END;
  275.     ANSIst := '';
  276.     EXIT;
  277.   END;
  278.   IF Ch IN ['0'..'9',';'] THEN ANSIst := ANSIst + Ch;
  279.   IF LENGTH(ANSIst) > 50 THEN BEGIN
  280.     ANSIWrite(ANSIst);
  281.     ANSIst := '';
  282.     EXIT;
  283.   END;
  284. END;
  285.  
  286. PROCEDURE DisplayANSIstr(S : STRING);
  287. VAR
  288.   I : BYTE;
  289. BEGIN
  290.   FOR I := 1 TO LENGTH(S) DO DisplayANSI(S[I]);
  291. END;
  292.  
  293. PROCEDURE ResetAnsi;
  294. BEGIN
  295.   ANSIst    := '';
  296.   ANSI_SCPL := - 1;
  297.   ANSI_SCPC := - 1;
  298.   ANSI_FG   := 7;
  299.   ANSI_BG   := 0;
  300.   ANSI_C    := FALSE;
  301.   ANSI_I    := FALSE;
  302.   ANSI_B    := FALSE;
  303.   ANSI_R    := FALSE;
  304. END;
  305.  
  306. BEGIN
  307.   ResetAnsi;
  308. END.
  309.